home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / imlib201 / uimage.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  14.0 KB  |  457 lines
  1.  
  2. {Part of Imagelib VCL/DLL Library.
  3.  
  4. Written by Jan Dekkers and Kevin Adams}
  5.  
  6. {this unit uses the tmultiimage component which must be added, select
  7.  Options/Install Components/Add and add reg_im20.pas}
  8.  
  9. unit Uimage;
  10.  
  11. interface
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  14.   Forms, Dialogs, StdCtrls, FileCtrl, tmulti, VBXCtrl, Switch, Spin,
  15.   Buttons, UFullscr, Menus, Uabout, ExtCtrls, Gauges, printers, U_p_size;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     DriveComboBox1: TDriveComboBox;
  20.     DirectoryListBox1: TDirectoryListBox;
  21.     FileListBox1: TFileListBox;
  22.     Sstretch: TBiSwitch;
  23.     Label1: TLabel;
  24.     SaveAs: TBiSwitch;
  25.     Label4: TLabel;
  26.     SaveDialog1: TSaveDialog;
  27.     SaveButton: TBitBtn;
  28.     QualitySpin: TSpinEdit;
  29.     Smoothspin: TSpinEdit;
  30.     QualityLabel: TLabel;
  31.     SmoothLabel: TLabel;
  32.     GroupBox1: TGroupBox;
  33.     res4: TRadioButton;
  34.     res24: TRadioButton;
  35.     res8: TRadioButton;
  36.     GroupBox2: TGroupBox;
  37.     Label5: TLabel;
  38.     Label6: TLabel;
  39.     Label7: TLabel;
  40.     DitherOneNo: TRadioButton;
  41.     DitherOneYes: TRadioButton;
  42.     DitherTwoNo: TRadioButton;
  43.     DitherTwoYes: TRadioButton;
  44.     Dither24Bit: TRadioButton;
  45.     MainMenu1: TMainMenu;
  46.     N1: TMenuItem;
  47.     O1: TMenuItem;
  48.     N2: TMenuItem;
  49.     N3: TMenuItem;
  50.     E1: TMenuItem;
  51.     A1: TMenuItem;
  52.     OpenDialog1: TOpenDialog;
  53.     N4: TMenuItem;
  54.     Print1: TMenuItem;
  55.     PrintSetup1: TMenuItem;
  56.     PrinterSetupDialog1: TPrinterSetupDialog;
  57.     PrintDialog1: TPrintDialog;
  58.     PrintOptions1: TMenuItem;
  59.     MultiImage1: TMultiImage;
  60.     Gauge1: TGauge;
  61.     Label9: TLabel;
  62.     Label10: TLabel;
  63.     Label11: TLabel;
  64.     Label12: TLabel;
  65.     Label13: TLabel;
  66.     Label14: TLabel;
  67.     Label15: TLabel;
  68.     Edit1: TEdit;
  69.     Edit2: TEdit;
  70.     Edit3: TEdit;
  71.     Edit4: TEdit;
  72.     Edit5: TEdit;
  73.     Edit6: TEdit;
  74.     Edit7: TEdit;
  75.     GetInfoChecked: TCheckBox;
  76.     Label8: TLabel;
  77.     Edit8: TEdit;
  78.     CheckBox1: TCheckBox;
  79.     procedure DriveComboBox1Change(Sender: TObject);
  80.     procedure DirectoryListBox1Change(Sender: TObject);
  81.     procedure FileListBox1Change(Sender: TObject);
  82.     procedure SstretchOnOff(Sender: TObject);
  83.     procedure FormCreate(Sender: TObject);
  84.     procedure resClick(Sender: TObject);
  85.     procedure DitherClick(Sender: TObject);
  86.     procedure SaveButtonClick(Sender: TObject);
  87.     procedure MultiImage1Click(Sender: TObject);
  88.     procedure E1Click(Sender: TObject);
  89.     procedure O1Click(Sender: TObject);
  90.     procedure A1Click(Sender: TObject);
  91.     procedure setsavevisible(Sender: TObject);
  92.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  93.     procedure Print1Click(Sender: TObject);
  94.     procedure PrintSetup1Click(Sender: TObject);
  95.     procedure PrintOptions1Click(Sender: TObject);
  96.     procedure GetInfoCheckedClick(Sender: TObject);
  97.     procedure CheckBox1Click(Sender: TObject);
  98.   private
  99.     { Private declarations }
  100.     oldsavefiles : TstringList;
  101.     oldreadfiles : TstringList;
  102.    procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  103.    procedure DisPlayInfo(dis : boolean);
  104.   public
  105.     { Public declarations }
  106.   end;
  107.  
  108. var
  109.   Form1: TForm1;
  110.  
  111. implementation
  112.  
  113. {$R *.DFM}
  114.  
  115. {---------------------------------------------------------------------}
  116. procedure ImageLibCallBack(i : integer); export;
  117. {Callback function from the dll, EXPORT IS REQUIRED}
  118. begin
  119.   Form1.Gauge1.Progress:=i;
  120.   Application.ProcessMessages;
  121. end;
  122. {---------------------------------------------------------------------}
  123.  
  124. procedure TForm1.DriveComboBox1Change(Sender: TObject);
  125. {update the drive of DirectoryListBox1 with the drive of DriveComboBox1}
  126. begin
  127.   DirectoryListBox1.Drive := DriveComboBox1.Drive;
  128. end;
  129. {---------------------------------------------------------------------}
  130.  
  131. procedure TForm1.DisPlayInfo(dis : boolean);
  132. begin
  133.     if dis then begin
  134.        {display the image info}
  135.        Edit1.Text:=IntToStr(MultiImage1.Bwidth);
  136.        Edit2.Text:=IntToStr(MultiImage1.BHeight);
  137.        Edit3.Text:=IntToStr(MultiImage1.Bbitspixel);
  138.        Edit4.Text:=IntToStr(MultiImage1.Bplanes);
  139.        Edit5.Text:=IntToStr(MultiImage1.Bnumcolors);
  140.        Edit6.Text:=MultiImage1.BFileType;
  141.        Edit7.Text:=MultiImage1.Bcompression;
  142.        Edit8.Text:=IntToStr(MultiImage1.BSize);
  143.      end else begin
  144.       {set the image info to ''}
  145.        Edit1.Text:='';
  146.        Edit2.Text:='';
  147.        Edit3.Text:='';
  148.        Edit4.Text:='';
  149.        Edit5.Text:='';
  150.        Edit6.Text:='';
  151.        Edit7.Text:='';
  152.        Edit8.Text:='';
  153.      end;
  154. end;
  155. {---------------------------------------------------------------------}
  156.  
  157. procedure TForm1.DirectoryListBox1Change(Sender: TObject);
  158. {update the directory of FileListBox1 with the directory of FileListBox1}
  159. begin
  160.   FileListBox1.Directory := DirectoryListBox1.Directory;
  161. end;
  162. {---------------------------------------------------------------------}
  163.  
  164. procedure TForm1.FileListBox1Change(Sender: TObject);
  165. {Display the image of the FileListBox1.filename}
  166. begin
  167.  {set hourglass cursor}
  168.   screen.cursor:=crHourGlass;
  169.  
  170.  {delete the old image}
  171.   MultiImage1.imagename:='';
  172.  
  173.  {display an image using the vcl}
  174.   MultiImage1.imagename:=FileListBox1.filename;
  175.  
  176.   {Request fileinfo from the DLL}
  177.   {Note, fileinfo will not work on WMF and ICO}
  178.   if GetInfoChecked.Checked then
  179.    DisplayInfo(true) else DisplayInfo(false);
  180.  
  181.   {Reset the gauge}
  182.   Gauge1.Progress:=0;
  183.  
  184.  {add filename to the history list of the open dialog}
  185.   oldreadfiles.add(FileListBox1.filename);
  186.  
  187.  {copy the stringlist to the historylist}
  188.   OpenDialog1.historylist:=oldreadfiles;
  189.  
  190.   {set default cursor}
  191.   screen.cursor:=crDefault;
  192. end;
  193. {---------------------------------------------------------------------}
  194.  
  195. procedure TForm1.SstretchOnOff(Sender: TObject);
  196. {set strech mode}
  197. begin
  198.   MultiImage1.stretch:=Sstretch.Pon;
  199. end;
  200. {---------------------------------------------------------------------}
  201.  
  202. procedure TForm1.setsavevisible(Sender: TObject);
  203. {hide or show jpeg save options}
  204. begin
  205.     QualitySpin.visible:=SaveAs.Pon;
  206.     Smoothspin.visible:=SaveAs.Pon;
  207.     QualityLabel.visible:=SaveAs.Pon;
  208.     SmoothLabel.visible:=SaveAs.Pon;
  209. end;
  210. {---------------------------------------------------------------------}
  211.  
  212. procedure TForm1.FormCreate(Sender: TObject);
  213. {what we do on create}
  214. begin
  215.     {Define the callback procedure}
  216.     TMultiImageCallBack:=ImageLibCallBack;
  217.  
  218.     {set the value of the QualitySpin to the value of JPegSaveQuality}
  219.     QualitySpin.value:=MultiImage1.JPegSaveQuality;
  220.  
  221.     {set the value of the Smoothspin to the value of JPegSaveSmooth}
  222.     Smoothspin.value:=MultiImage1.JPegSaveSmooth;
  223.  
  224.     {show the save options depending on the saveas switch pon state}
  225.     setsavevisible(sender);
  226.  
  227.     {create temporary history stringlists}
  228.     oldsavefiles := TstringList.create;
  229.     oldreadfiles := TstringList.create;
  230. end;
  231. {---------------------------------------------------------------------}
  232.  
  233. procedure TForm1.resClick(Sender: TObject);
  234. {Set the jpeg resolution to either 16, 256 or true color in the vcl}
  235. begin
  236.  {set jpeg show resolution to 4 bit 16 color}
  237.  if res4.checked  then MultiImage1.JPegResolution:=4;
  238.  
  239.  {set jpeg show resolution to 8 bit 256 color}
  240.  if res8.checked  then MultiImage1.JPegResolution:=8;
  241.  
  242.  {set jpeg show resolution to 24 bit true color}
  243.  if res24.checked then MultiImage1.JPegResolution:=24;
  244. end;
  245. {---------------------------------------------------------------------}
  246.  
  247. procedure TForm1.DitherClick(Sender: TObject);
  248. {Set the jpeg dither in the vcl}
  249. begin
  250.   {set the jpeg show dither to none (best choice for true color 24 bit}
  251.   if Dither24Bit.checked  then MultiImage1.JPegDither:=0;
  252.  
  253.   {set the jpeg show dither to one pass none}
  254.   if DitherOneNo.checked  then MultiImage1.JPegDither:=1;
  255.  
  256.   {set the jpeg show dither to one pass dithered (best choice for 16 colors)}
  257.   if DitherOneYes.checked  then MultiImage1.JPegDither:=2;
  258.  
  259.   {set the jpeg show dither to one pass none}
  260.   if DitherTwoNo.checked  then MultiImage1.JPegDither:=3;
  261.  
  262.   {set the jpeg show dither to two pass dithered (best choice for 256 colors)}
  263.   if DitherTwoYes.checked  then MultiImage1.JPegDither:=4;
  264. end;
  265. {---------------------------------------------------------------------}
  266.  
  267. procedure TForm1.SaveButtonClick(Sender: TObject);
  268. {save a jpeg or bmp}
  269. begin
  270.  {open save dialog}
  271.  if SaveDialog1.execute then begin
  272.  
  273.  {set hourglass cursor}
  274.   screen.cursor:=crHourGlass;
  275.  
  276.   {save it if the extension is jpg}
  277.   if UpperCase(ExtractFileExt(SaveDialog1.Filename)) =  '.JPG' then
  278.     MultiImage1.SaveAsJpg(SaveDialog1.FileName);
  279.  
  280.   {save it if the extension is bmp}
  281.   if UpperCase(ExtractFileExt(SaveDialog1.Filename)) =  '.BMP' then
  282.     MultiImage1.Picture.SaveToFile(SaveDialog1.FileName);
  283.  
  284.  {add filename to the history list of the save dialog}
  285.   oldSavefiles.add(SaveDialog1.filename);
  286.  
  287.  {copy the stringlist to the historylist}
  288.   SaveDialog1.historylist:=oldSavefiles;
  289.  
  290.  {set default cursor}
  291.   screen.cursor:=crDefault;
  292.  
  293.   {update the filelist box sothat the file saved shows up}
  294.   FileListBox1.Update;
  295.  end;
  296. end;
  297. {---------------------------------------------------------------------}
  298.  
  299. procedure TForm1.MultiImage1Click(Sender: TObject);
  300. {show fullscreen}
  301. begin
  302.   {copy image to fullscreen image}
  303.   FullSlide.MultiImage1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  304.   {show the image fulscreen}
  305.   FullSlide.showmodal;
  306. end;
  307. {---------------------------------------------------------------------}
  308.  
  309. procedure TForm1.E1Click(Sender: TObject);
  310. {exit the program}
  311. begin
  312.  close;
  313. end;
  314. {---------------------------------------------------------------------}
  315.  
  316. procedure TForm1.O1Click(Sender: TObject);
  317. {open a image using the open dialog}
  318. begin
  319.   if OpenDialog1.execute then begin
  320.  
  321.    {set hourglass cursor}
  322.     screen.cursor:=crHourGlass;
  323.  
  324.    {delete the old image}
  325.     MultiImage1.imagename:='';
  326.  
  327.     {display an image using the vcl}
  328.     MultiImage1.imagename:=OpenDialog1.filename;
  329.  
  330.    {Request fileinfo from the DLL}
  331.    {Note, fileinfo will not work on WMF and ICO}
  332.     if GetInfoChecked.Checked then
  333.       DisplayInfo(true) else DisplayInfo(false);
  334.  
  335.     {reset the gauge}
  336.     Gauge1.Progress:=0;
  337.  
  338.    {add filename to the history list of the open dialog}
  339.     oldreadfiles.add(OpenDialog1.filename);
  340.  
  341.    {copy the stringlist to the historylist}
  342.     OpenDialog1.historylist:=oldreadfiles;
  343.  
  344.    {set default cursor}
  345.     screen.cursor:=crDefault;
  346.   end;
  347. end;
  348. {---------------------------------------------------------------------}
  349.  
  350. procedure TForm1.A1Click(Sender: TObject);
  351. {about box}
  352. begin
  353. {Copy the image to the image of he about box}
  354.  AboutBox.Image1.Picture.Graphic:=MultiImage1.Picture.Graphic;
  355. {show the about box}
  356.  AboutBox.showmodal;
  357. end;
  358. {---------------------------------------------------------------------}
  359.  
  360. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  361. {what to do on exit}
  362. begin
  363.    {release memory of the stringlist boxes}
  364.     oldsavefiles.free;
  365.     oldreadfiles.free;
  366. end;
  367. {---------------------------------------------------------------------}
  368.  
  369. procedure TForm1.Print1Click(Sender: TObject);
  370. {Print image}
  371. begin
  372.   if PrintDialog1.execute then begin
  373.    {Sent the doc to the printer}
  374.    Printer.Begindoc;
  375.    {Print the TDBMultiImage bitmap}
  376.    PrintBitmap(MultiImage1.Picture.Bitmap,0,0);
  377.    {End the printjob and close the bitmap}
  378.    Printer.Enddoc;
  379.   end;
  380. end;
  381. {---------------------------------------------------------------------}
  382.  
  383. procedure TForm1.PrintSetup1Click(Sender: TObject);
  384. {Set up printer}
  385. begin
  386.   PrinterSetupDialog1.Execute;
  387. end;
  388. {---------------------------------------------------------------------}
  389.  
  390. procedure TForm1.PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
  391. {Print using borland's how to print a bitmap example code}
  392.   var
  393.     Info: PBitmapInfo;
  394.     InfoSize: Integer;
  395.     Image: Pointer;
  396.     ImageSize: Longint;
  397.   begin
  398.     with Bitmap do
  399.     begin
  400.       GetDIBSizes(Handle, InfoSize, ImageSize);
  401.       Info := MemAlloc(InfoSize);
  402.       try
  403.         Image := MemAlloc(ImageSize);
  404.         try
  405.           GetDIB(Handle, Palette, Info^, Image^);
  406.           with Info^.bmiHeader do begin
  407.              if (Printersize.HeigthSpinEdit.Value >1) and (Printersize.WidthSpinEdit.Value >1) then
  408.               StretchDIBits(Printer.Canvas.Handle, X, Y, Printersize.WidthSpinEdit.Value,
  409.               Printersize.HeigthSpinEdit.Value, 0, 0, biWidth, biHeight, Image, Info^,
  410.               DIB_RGB_COLORS, SRCCOPY)
  411.              else
  412.               StretchDIBits(Printer.Canvas.Handle, X, Y, Width,
  413.               Height, 0, 0, biWidth, biHeight, Image, Info^,
  414.               DIB_RGB_COLORS, SRCCOPY);
  415.           end;
  416.         finally
  417.           FreeMem(Image, ImageSize);
  418.         end;
  419.       finally
  420.         FreeMem(Info, InfoSize);
  421.       end;
  422.     end;
  423.   end;
  424. {---------------------------------------------------------------------}
  425.  
  426. procedure TForm1.PrintOptions1Click(Sender: TObject);
  427. {select the size}
  428. begin
  429.  {Initialize the height spinedit of the printsize dialog box}
  430.  Printersize.HeigthSpinEdit.Value:=MultiImage1.Picture.BitMap.Height;
  431. {Initialize the width spinedit of the printsize dialog box}
  432.  Printersize.WidthSpinEdit.Value:=MultiImage1.Picture.BitMap.Width;
  433.  {Show it}
  434.  Printersize.ShowModal;
  435.  {Hide it if done}
  436.  Printersize.hide;
  437. end;
  438. {---------------------------------------------------------------------}
  439.  
  440. procedure TForm1.GetInfoCheckedClick(Sender: TObject);
  441. {depending on the state of the checkbox,  display or not display info}
  442. begin
  443.  DisPlayInfo(GetInfoChecked.Checked);
  444. end;
  445. {---------------------------------------------------------------------}
  446.  
  447. procedure TForm1.CheckBox1Click(Sender: TObject);
  448. {depending on the state of the checkbox, center or not center image}
  449. begin
  450.  MultiImage1.Center:=CheckBox1.Checked;
  451. end;
  452. {---------------------------------------------------------------------}
  453. {---------------------------------------------------------------------}
  454. {---------------------------------------------------------------------}
  455.  
  456. end.
  457.